HA$PBExportHeader$w_prueba_filestream.srw
forward
global type w_prueba_filestream from window
end type
type cb_2 from commandbutton within w_prueba_filestream
end type
type cb_4 from commandbutton within w_prueba_filestream
end type
type sle_docid from singlelineedit within w_prueba_filestream
end type
type cb_1 from commandbutton within w_prueba_filestream
end type
end forward

global type w_prueba_filestream from window
integer width = 1042
integer height = 564
boolean titlebar = true
string title = "GRABAR DOCUMENTOS"
boolean controlmenu = true
boolean minbox = true
boolean maxbox = true
boolean resizable = true
long backcolor = 67108864
string icon = "AppIcon!"
boolean center = true
cb_2 cb_2
cb_4 cb_4
sle_docid sle_docid
cb_1 cb_1
end type
global w_prueba_filestream w_prueba_filestream

type prototypes
// declaraci$$HEX1$$f300$$ENDHEX$$n de 'external funcions' 
Function ulong CreateFile ( string lpFileName, ulong dwDesiredAccess, ulong dwShareMode, ulong lpSecurityAttributes, & 
ulong dwCreationDisposition, ulong dwFlagsAndAttributes, ulong hTemplateFile ) Library "kernel32.dll" Alias For "CreateFileA" 

Function boolean CloseHandle ( & 
ulong hObject & 
) Library "kernel32.dll" 
Function boolean WriteFile ( & 
ulong hFile, & 
Ref blob lpBuffer, & 
ulong nNumberOfBytesToRead, & 
Ref ulong lpNumberOfBytesRead, & 
ulong lpOverlapped & 
) Library "kernel32.dll" 

end prototypes

type variables

string docname,named,is_mes,is_vouch,is_file
integer value
OLEObject iOLE_Doc


Constant ULong INVALID_HANDLE_VALUE = -1 
Constant ULong GENERIC_READ = 2147483648 
Constant ULong GENERIC_WRITE = 1073741824 
Constant ULong FILE_SHARE_READ = 1 
Constant ULong FILE_SHARE_WRITE = 2 
Constant ULong CREATE_NEW = 1 
Constant ULong CREATE_ALWAYS = 2 
Constant ULong OPEN_EXISTING = 3 
Constant ULong OPEN_ALWAYS = 4 
Constant ULong TRUNCATE_EXISTING = 5 


end variables

on w_prueba_filestream.create
this.cb_2=create cb_2
this.cb_4=create cb_4
this.sle_docid=create sle_docid
this.cb_1=create cb_1
this.Control[]={this.cb_2,&
this.cb_4,&
this.sle_docid,&
this.cb_1}
end on

on w_prueba_filestream.destroy
destroy(this.cb_2)
destroy(this.cb_4)
destroy(this.sle_docid)
destroy(this.cb_1)
end on

event open;// Profile filestream
SQLCA.DBMS = "SNC SQL Native Client(OLE DB)"
SQLCA.LogPass = 'F@bio40325188'
SQLCA.ServerName = "percy\sql2008"
SQLCA.LogId = "sa"
SQLCA.AutoCommit = False
SQLCA.DBParm = "Database='FileStreamTestDB',Provider='SQLNCLI10'"
connect;

if sqlca.sqlcode <> 0 then
	//w_splash.SetPosition(NoTopmost!)
	MessageBox ("Sorry! Cannot Connect To Database", sqlca.sqlerrtext)
end if

iole_Doc = Create OLEObject


end event

event close;Destroy iole_Doc
end event

type cb_2 from commandbutton within w_prueba_filestream
integer x = 50
integer y = 308
integer width = 402
integer height = 112
integer taborder = 40
integer textsize = -10
integer weight = 700
fontcharset fontcharset = ansi!
fontpitch fontpitch = variable!
fontfamily fontfamily = swiss!
string facename = "Tahoma"
string text = "LIMPIAR"
end type

event clicked; DELETE FROM ole;
 COMMIT;
end event

type cb_4 from commandbutton within w_prueba_filestream
integer x = 457
integer y = 164
integer width = 402
integer height = 112
integer taborder = 30
integer textsize = -10
integer weight = 700
fontcharset fontcharset = ansi!
fontpitch fontpitch = variable!
fontfamily fontfamily = swiss!
string facename = "Tahoma"
string text = "VIEW"
end type

event clicked;String ls_DocID, ls_DocPath, ls_MessageTitle
Integer li_FileNum, li_Count
blob	lblb_Doc ,lbl_temp

ULong lul_file, lul_bytes, lul_length 
Blob lblob_filedata 
Boolean lb_result  
String ls_winFile, ls_fname 



ls_MessageTitle = "PB9 OLE DB Example"

//MessageBox ( ls_MessageTitle, "This function allows you to select a Word document from the database and edit it in Word. ~r~n~r~nPlease note that after editing, the document is not automatically saved to the database." )

ls_DocID = sle_DocID.Text

If len ( trim ( ls_docID ) ) = 0 Then
	MessageBox ( ls_MessageTitle, "Please enter a Document ID" )
	sle_DocID.SetFocus ( )
	Return
End If

//ls_DocPath = 'C:\PB9 OLE DB Example.doc'
ls_DocPath = 'C:\PB9 OLE DB Example.xls'

If FileExists ( ls_DocPath ) Then
	FileDelete ( ls_DocPath )
End If

Select count(*) into :li_count from ole where id = :ls_docID;

If li_count = 0 then
	MessageBox ( ls_MessageTitle, "A document with this ID does not exist in the database. Please enter another document ID" )
	sle_DocID.SetFocus ( )
	Return
End If

li_filenum = FileOpen ( ls_docpath, StreamMode!, Write! )
//
If li_filenum = -1 or IsNull ( li_filenum ) Then
	MessageBox ( ls_MessageTitle, "Error creating file" )
	Return
End If

isnull(lblb_Doc)

SelectBLOB doc
Into	:lblb_Doc
From	ole
Where	id = :ls_DocID ;

If SQLCA.SQLCode <> 0 Then
	MessageBox ("SQLErrorText", SQLCA.SQLErrText )
	Return
End If
long ll_tam , ll_long = 0 ,li_pos=0

ll_tam = len(lblb_Doc) 

//MessageBox ( ls_MessageTitle, "len bytes =" + string( len(lblb_Doc) ) )

isnull(lbl_temp)
//if ll_tam <= 32766 then 
//	If FileWrite ( li_FileNum, lblb_Doc ) <= 0 Then
//		MessageBox ( ls_MessageTitle, "Error. Please try again" )
//		Return
//	End If
//else 
//	Do 
//		lbl_temp = BlobMid(lblb_Doc,li_pos,32765) 
//		ll_long = ll_long + FileWrite(li_filenum,lbl_temp) 
//		li_pos = li_pos + 32765 
//	Loop While ll_long <= ll_tam 
//end if 

If FileWriteEx ( li_FileNum, lblb_Doc,ll_tam ) <= 0 Then
//If FileWrite ( li_FileNum, lblb_Doc ) <= 0 Then
	MessageBox ( ls_MessageTitle, "Error. Please try again" )
	Return
End If
//MessageBox ( ls_MessageTitle, "len bytes =" + string( len(lblb_Doc) ) )

/* 
	ULong lul_file, lul_bytes, lul_length 
	Blob lblob_filedata 
	Boolean lb_result 
	String ls_winFile, ls_fname 
	
	// IMPORTANTE: writefile tiene una limitaci$$HEX1$$f300$$ENDHEX$$n de 65kb (en vez de 1GB), cuando NO se 
	// escribe en el mismo disco. (no estoy seguro del l$$HEX1$$ed00$$ENDHEX$$mite superior de 1GB, creo que 
	// se pueden escribir archivos de m$$HEX1$$e100$$ENDHEX$$s tama$$HEX1$$f100$$ENDHEX$$o pero habr$$HEX2$$e1002000$$ENDHEX$$que adapter el 
	// valor de GENERIC_WRITE 
	// entonces cuidado: si as_filename es en alg$$HEX1$$fa00$$ENDHEX$$n sitio de red, se limita el tama$$HEX1$$f100$$ENDHEX$$o 
	// m$$HEX1$$e100$$ENDHEX$$ximo a 65kb 
	// tiene que ser siempre un archivo en C: como por ejemplo el dir. temporal de 
	// windows, luego Mover hacia donde sea as_filename. con MoveFileExA() 
	
	string ls_winFile = 'C:\temp\mi_imagen_recuperado.jpg' 

		// tu recuperaci$$HEX1$$f300$$ENDHEX$$n de base de datos del blob 
		SELECTBLOB .... into :lblob_filedata FROM ... .ETC. 
		
		// open file for write 
		lul_file = CreateFile(ls_winFile, GENERIC_WRITE, & 
		FILE_SHARE_WRITE, 0, OPEN_ALWAYS, 0, 0) 
		If lul_file = INVALID_HANDLE_VALUE Then 
		Return False 
		End If 
		
		// write the entire file contents in one shot 
		// creo que el l$$HEX1$$ed00$$ENDHEX$$mite est$$HEX2$$e1002000$$ENDHEX$$en un GigaByte: GENERIC_WRITE 
		lb_result = WriteFile(lul_file, ablob_data, & 
		lul_length, lul_bytes, 0) 
		
		// close the file 
		CloseHandle(lul_file) 
		
		if not lb_result then 
		return false 
		end if 
		
		return true 


*/

// open file for write 
//		lul_file = CreateFile(ls_DocPath, GENERIC_WRITE,	FILE_SHARE_WRITE, 0, OPEN_ALWAYS, 0, 0) 
//		
//		
//		If lul_file = INVALID_HANDLE_VALUE Then 
//			Return  
//		End If 
//		
//		// write the entire file contents in one shot 
//		// creo que el l$$HEX1$$ed00$$ENDHEX$$mite est$$HEX2$$e1002000$$ENDHEX$$en un GigaByte: GENERIC_WRITE 
//		lb_result = WriteFile(lul_file, lblb_Doc, & 
//									lul_length, lul_bytes, 0) 
//		
//		// close the file 
//		CloseHandle(lul_file) 
//		
//		if not lb_result then 
//			return 
//		end if 
//


FileClose ( li_FileNum )

//If iole_Doc.ConnectToNewObject("word.application") = 0 Then
//	iole_Doc.Documents.open( ls_DocPath )
//Else
//	MessageBox(ls_MessageTitle, 'Unable to start an OLE server process!', Exclamation!)
//End If
integer RetVal,li_ret
string ls_err
li_ret = iole_Doc.ConnectToObject("excel.application") 
if li_ret <> 0 then 
	li_ret = iole_Doc.ConnectToNewObject("excel.application")
end if 

choose case li_ret 
	//case 0 
	//ls_err='Conexi$$HEX1$$f300$$ENDHEX$$n Satisfactoria con OLE (Excel)' 
	case -1 
	ls_err='Error. Llamada Inv$$HEX1$$e100$$ENDHEX$$lida a objeto OLE (Excel)' 
	case -2 
	ls_err='Error. Nombre de la clase no encontrada con OLE (Excel)' 
	case -3 
	ls_err='Error. El objeto OLEObject no puede ser creado (Excel)' 
	case -4 
	ls_err='Error. No se puede conectar con el objeto (EXCEL)' 
	case -5 
	ls_err='Error no tratado (EXCEL)' 
	case else 
	ls_err='Error desconocido: '+string(li_ret)+'(EXCEL)' 
end choose 

//If iole_Doc.ConnectToNewObject("excel.application") = 0 Then
iole_Doc.workbooks.open( ls_DocPath )
//	RetVal = iole_Doc.ConnectToObject (ls_DocPath)
//
//	If RetVal < 0 then
//		MessageBox("Error","ConnectToObject Failed")
//	End If
//Else
//	MessageBox(ls_MessageTitle, 'Unable to start an OLE server process!', Exclamation!)
//End If
//// Display the document in Word
iole_Doc.Visible=TRUE
commit;

end event

type sle_docid from singlelineedit within w_prueba_filestream
integer x = 32
integer y = 32
integer width = 832
integer height = 112
integer taborder = 10
integer textsize = -10
integer weight = 700
fontcharset fontcharset = ansi!
fontpitch fontpitch = variable!
fontfamily fontfamily = swiss!
string facename = "Tahoma"
long textcolor = 33554432
string text = "item1"
borderstyle borderstyle = stylelowered!
end type

type cb_1 from commandbutton within w_prueba_filestream
integer x = 32
integer y = 164
integer width = 402
integer height = 112
integer taborder = 10
integer textsize = -10
integer weight = 700
fontcharset fontcharset = ansi!
fontpitch fontpitch = variable!
fontfamily fontfamily = swiss!
string facename = "Tahoma"
string text = "ADJUNTAR"
end type

event clicked;string  	ls_docID, ls_docpath, ls_docname, ls_MessageTitle
integer 	i, li_count, li_rtn, li_filenum,li_len
Blob		lblb_Doc,lbl_temp
long ll_long
ls_MessageTitle = "Grabar Documentos en Base de Datos"
isnull(lblb_Doc)
isnull(lbl_temp)
//MessageBox ( ls_MessageTitle, "This function allows you to select a Word document from your disk and stores it in the database" )
ls_DocID = sle_DocID.text

If len ( trim ( ls_docID ) ) = 0 Then
	MessageBox ( ls_MessageTitle, "Please enter a Document ID" );	Return
End If

li_rtn = GetFileOpenName("PB9 OLE DB Example - Select File (less than 32765 characters long)", &
    ls_docpath, ls_docname, "DOC", &
    "Doc Files (*.DOC;*.XLS),*.DOC;*.XLS,", &
    "C:\", 16410)
li_filenum = FileOpen ( ls_docpath, StreamMode!, Read! )

If li_filenum = -1 or IsNull ( li_filenum ) Then
	MessageBox ( ls_MessageTitle, "Error opening file" )
	Return
End If
//ll_long = FileLength (ls_docpath)
If FileLength (ls_DocName) > 32765 Then
	MessageBox ( ls_MessageTitle, "File is too large. Please select a smaller file" )
	Return
End If

If FileLength ( ls_DocName ) = 0 Then
	MessageBox ( ls_MessageTitle, "File contains no data. Please select another file" )
	Return
End If

//If FileReadex ( li_FileNum, lblb_Doc ) <= 0 Then
//	MessageBox ( ls_MessageTitle, "Error. Please select another file" )
//	Return
//End If

Do While FileRead(li_FileNum,lbl_temp) > 0 
	lblb_Doc += lbl_temp 
Loop 

//FileReadEx(li_FileNum,lblb_Doc,len(lblb_Doc)) 
//MessageBox ( ls_MessageTitle, "len bytes =" + string( len(lblb_Doc) ) )
FileClose ( li_FileNum )

Select count(*) into :li_count from ole where id = :ls_docID;

If li_count > 0 then
	If MessageBox ( ls_MessageTitle, "A document with this ID exists. Do you want to replace it ?", Question!, YesNo! ) = 1 Then
		UpdateBlob ole
		set doc = :lblb_Doc
		where id = :ls_docid ;
 
		If SQLCA.SQLCode <> 0 Then
			MessageBox ("SQLErrorText", SQLCA.SQLErrText )
			Return
		End If
	Else
		Return
	End If
Else
	Insert into ole (id, description) values (:ls_docID, :ls_docname);
	If SQLCA.SQLCode <> 0 Then
		MessageBox ("SQLErrorText", SQLCA.SQLErrText )
		Return
	End If

	UpdateBlob ole	set doc = :lblb_Doc	where id = :ls_docid ;

	If SQLCA.SQLCode <> 0 Then
		MessageBox ("SQLErrorText", SQLCA.SQLErrText )
		Return
	End If
End If

MessageBox ( ls_MessageTitle, "File saved to database" )
commit;

//INSERT INTO FileStreamTest1 (TestId , Name ) VALUES ( NEWID (), 'item1'
//													//CAST (:emp_id_pic AS VARBINARY(MAX)) 
//													);
//								commit;
//


end event

